home *** CD-ROM | disk | FTP | other *** search
/ Fritz: All Fritz / All Fritz.zip / All Fritz / FILES / PROGMISC / PCSSP.LZH / PC-SSP.ZIP / MATOPS.ZIP / MATA.FOR < prev    next >
Text File  |  1985-11-29  |  2KB  |  59 lines
  1. C
  2. C     ..................................................................
  3. C
  4. C        SUBROUTINE MATA
  5. C
  6. C        PURPOSE
  7. C           PREMULTIPLY A MATRIX BY ITS TRANSPOSE TO FORM A
  8. C           SYMMETRIC MATRIX
  9. C
  10. C        USAGE
  11. C           CALL MATA(A,R,N,M,MS)
  12. C
  13. C        DESCRIPTION OF PARAMETERS
  14. C           A  - NAME OF INPUT MATRIX
  15. C           R  - NAME OF OUTPUT MATRIX
  16. C           N  - NUMBER OF ROWS IN A
  17. C           M  - NUMBER OF COLUMNS IN A. ALSO NUMBER OF ROWS AND
  18. C                NUMBER OF COLUMNS OF R.
  19. C           MS  - ONE DIGIT NUMBER FOR STORAGE MODE OF MATRIX A
  20. C                  0 - GENERAL
  21. C                  1 - SYMMETRIC
  22. C                  2 - DIAGONAL
  23. C
  24. C        REMARKS
  25. C           MATRIX R CANNOT BE IN THE SAME LOCATION AS MATRIX A
  26. C           MATRIX R IS ALWAYS A SYMMETRIC MATRIX WITH A STORAGE MODE=1
  27. C
  28. C        SUBROUTINES AND FUNCTION SUBPROGRAMS REQUIRED
  29. C           LOC
  30. C
  31. C        METHOD
  32. C           CALCULATION OF (A TRANSPOSE A) RESULTS IN A SYMMETRIC MATRIX
  33. C           REGARDLESS OF THE STORAGE MODE OF THE INPUT MATRIX. THE
  34. C           ELEMENTS OF MATRIX A ARE NOT CHANGED.
  35. C
  36. C     ..................................................................
  37. C
  38.       SUBROUTINE MATA(A,R,N,M,MS)
  39.       DIMENSION A(1),R(1)
  40. C
  41.       DO 60 K=1,M
  42.       KX=(K*K-K)/2
  43.       DO 60 J=1,M
  44.       IF(J-K) 10,10,60
  45.    10 IR=J+KX
  46.       R(IR)=0
  47.       DO 60 I=1,N
  48.       IF(MS) 20,40,20
  49.    20 CALL LOC(I,J,IA,N,M,MS)
  50.       CALL LOC(I,K,IB,N,M,MS)
  51.       IF(IA) 30,60,30
  52.    30 IF(IB) 50,60,50
  53.    40 IA=N*(J-1)+I
  54.       IB=N*(K-1)+I
  55.    50 R(IR)=R(IR)+A(IA)*A(IB)
  56.    60 CONTINUE
  57.       RETURN
  58.       END
  59.